Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-04/wtjmarch.zip/LIFE.ZIP/POLY12.COD

Text File | 1991-12-09 | 6KB | 175 lines

** Listing 1
** TLifeWindow object definition in Pascal

TLifeWindow = object(TWindow)
  cells : TLifeCells;            { cells being mutated }
  speed : Integer;               { timer speed         }
  running : Boolean;             { is timer running?   }
  rows : Integer;                { visible rows        }
  cols : Integer;                { visible columns     }
  gridSize : Integer;            { for drawing a cell  }
  mouseDown : Boolean;           { is mouse down?      }
  xDown : Integer;               { x location in grid  }
  yDown : Integer;               { y location in grid  }
  mutateDC : HDC;                { draw each mutation  }
  mouseMoveDC : HDC;             { draw mouse moves    }
  ...
  { menu response methods }
  procedure Clear(var Msg: TMessage); virtual cm_First + cm_Clear;
  procedure Go(var Msg: TMessage); virtual cm_First + cm_Go;
  procedure Stop(var Msg: TMessage); virtual cm_First + cm_Stop;
  procedure About(var Msg: TMessage); virtual cm_First + cm_About;
  ...
  { windows message response methods }
  procedure wmKeyDown(var Msg: TMessage); virtual wm_KeyDown;
  procedure wmLButtonDown(var Msg: TMessage); virtual wm_LButtonDown;
  procedure wmLButtonUp(var Msg: TMessage); virtual wm_LButtonUp;
  procedure wmMouseMove(var Msg: TMessage); virtual wm_MouseMove;
 ...
end;

** Listing 2

// C++ version of the TLifeWindow object

class TLifeWindow : public TWindow {
  TLifeCells cells;            /* cells being mutated */
  int speed;                   /* timer speed         */
  Boolean running;             /* is timer running?   */
  ...
public:
  /* menu response methods */
  virtual void Clear(TMessage& Msg) = [ CM_FIRST + cm_Clear ];
  virtual void Go(TMessage& Msg) = [ CM_FIRST + cm_Go ];
  virtual void Stop(TMessage& Msg) = [ CM_FIRST + cm_Stop ];
  ...
  /* windows message response methods */
  virtual void WMKeyDown(TMessage& Msg) = [ WM_FIRST + WM_KEYDOWN ];
  virtual void WMLButtonDown(TMessage& Msg) = [WM_FIRST + WM_LBUTTONDOWN];
  virtual void WMLButtonUp(TMessage& Msg) = [ WM_FIRST + WM_LBUTTONUP ];
  virtual void WMMouseMove(TMessage& Msg) = [ WM_FIRST + WM_MOUSEMOVE ];
  ...
};

** Listing 3
** Mouse response methods

{ Begin capturing mouse movement when the left button is pressed.
  A display context is taken; it is freed in the wmLButtonUp method.
}
procedure TLifeWindow.wmLButtonDown(var Msg: TMessage);
begin
  if not mouseDown then
  begin
    xDown := -1;     { sentinal values to track movement }
    yDown := -1;
    mouseDown := True;
    mouseMoveDC := GetDC(HWindow);
    selectObject(mouseMoveDC, GetStockObject(White_Pen));
  end;
end;

{ Update the cells as the mouse is dragged }
procedure TLifeWindow.WMMouseMove(var Msg: TMessage);
var
 xScreen, yScreen, x, y : Integer;
 state : Boolean;
begin
  if mouseDown then
  begin
    { determine where clicked }
    xScreen := Msg.LParamLo;
    yScreen := Msg.LParamHi;
    { translate into cell coordinates }
    x := xScreen div gridSize;
    y := yScreen div gridSize;
    if (x <> xDown) or (y <> yDown) then      { a new position }
    begin
      { Invert the cell's state, then redraw }
      xDown := x;                             { store position }
      yDown := y;
      state := not(cells.aliveCell(x, y));
      cells.setCell(x, y, state);
      cells.drawCell(mouseMoveDC, x, y, state)
    end;
  end;
end;

{ Stop capturing mouse movement when mouse is released }
procedure TLifeWindow.wmLButtonUp(var Msg: TMessage);
begin
  wmMouseMove(Msg);  { force drawing in same spot }
  if mouseDown then
  begin
    mouseDown := False;
    selectObject(mouseMoveDC, GetStockObject(Black_Pen));
    releaseDC(HWindow, mouseMoveDC);
  end;
end;

** Listing 4
** Keyboard response method

{ Use keyboard to simulate mouse events.  Accelerator keys
  are handled as response methods. }
procedure TLifeWindow.wmKeyDown(var Msg: TMessage);
var x, y : Integer;
    pos : TPoint;
    key : word;
begin
  { Determine position of cursor in Window }
  getCursorPos(pos);
  screenToClient(HWindow, pos);
  x:=pos.x;
  y:=pos.y;
  { move the cursor position }
  key := Msg.WParam;
  case key of
    VK_UP    : y := y - gridSize;
    VK_DOWN  : y := y + gridSize;
    VK_RIGHT : x := x + gridSize;
    VK_LEFT  : x := x - gridSize;
    VK_HOME  :
      begin
       x := gridSize div 2;
       y := gridSize div 2;
      end;
    VK_END :
      begin
       x := attr.w - gridSize div 2;
       y := attr.h - gridSize div 2;
      end;
    VK_RETURN,
    VK_SPACE :
      begin
        { Simulate mouse pressing at cursor position }
        Msg.LParam := LongInt(pos);
        wmLButtonDown(Msg);
        wmLButtonUp(Msg);
      end;
    end;
    { Update position of cursor in window with clipping }
    if x < 0 then x := gridSize div 2;
    if y < 0 then y := gridSize div 2;
    if x > cols * gridSize then x:= attr.w - gridSize div 2;
    if y > rows * gridSize then y:= attr.h - gridSize div 2;
    pos.x := x;
    pos.y := y;
    clientToScreen(HWindow, pos);
    setCursorPos(pos.x, pos.y);
end;

** Listing 5
** Responding to timer messages

{ Create a display context for drawing and mutate the cells.
  Use a white pen for the border, then set it back when done. }
procedure TLifeWindow.wmTimer(var Msg: TMessage);
begin
  mutateDC:=getDC(HWindow);
  selectObject(mutateDC, GetStockObject(White_Pen));
  cells.mutate(mutateDC);
  selectObject(mutateDC, GetStockObject(Black_Pen));
  releaseDC(HWindow, mutateDC);
end;